perm filename TAX.OLD[TAX,LCS]1 blob
sn#091437 filedate 1974-03-12 generic text, type T, neo UTF8
00100 C***** INCOME TAX HELPER ******
00200 CC DIMENSION WAGES(10),DIV(10),RINT(10),BINC(10),
00300 CC 1 CAS(10),SUPS(10),ROY(10),PENS(10),CAPG(10),SITR(10),
00400 CC 1 OTH(10),EBEX(10),RMED(20),TAXES(10),XOTH(10),CONTR(10),
00500 CC 1 TLOSS(10),RMIN(10),DOC(10),DOTH(10),RTAX(10),RMORT(10),
00600 CC 1 ROTH(10),OCONT(10),OCASH(10),UNION(10),RMOTH(10),WTAX(10)
00700 CC 1,ETAX(10),FICA(10)
00800 COMMON K,ACC,IOUT
00900 IOUT=5
01000 C**** -99=BACKUP **************
01100 C*** UP TO 10 NUMBERS MAY BE ENTERED IF PROG. GIVES <CR> BEFORE ACCEPT.
01200 C 5=TTY 3=LPT
01300 ACC=-1
01400 TYPE 200
01500 ACCEPT 3,N
01600 IF(N.NE.'O')GO TO 60
01700 200 FORMAT(' N=NEW TAX WORK -- OR O=GET OLD FILE. H=HELP'/)
01800 TYPE 85
01900 ACCEPT 4,NAME
02000 GO TO 201
02100 33 FORMAT('+ STANDARD DEDUCTION - NOT MORE THAN $2000 OR $1000'/)
02200 45 FORMAT('+ REAL ESTATE.'/)
02300 55 FORMAT('+ INSURANCE REIMBURSEMENT.'/)
02400 57 FORMAT('+ ALIMONY PAID.'/)
02500 58 FORMAT('+ UNION DUES.'/)
02600 59 FORMAT('+ CHILD AND DEPENDENT CARE(FORM 2441)'/)
02700 60 FORMAT('+ TOTAL--- ',F10.2/)
02800 IF(N.NE.'H')GO TO 4
02900 TYPE 202
03000 CALL EXIT
03100 202 FORMAT(' ASK LCS FOR INFORMATION.')
03200 1 FORMAT(20F)
03300 2 FORMAT(F10.2/)
03400 3 FORMAT(A1)
03500 4 FORMAT(A5)
03600 I=' '
03700
03800 601 FORMAT(' ***** YOU ARE ON FORM 1040, PG.1 *****'/)
03900 WRITE(IOUT,601)
04000 IF(ACC.EQ.0)GO TO 102
04050 TYPE 604
04075 604 FORMAT(' TO BACKUP TYPE -99 '/)
04100 600 FORMAT('+ ARE YOU MARRIED, FILING SEPARATELY? '$)
04200 CALL TYP(3,I)
04300 ACCEPT 3,MFS
04400 102 CALL TYP(7,I)
04500 WRITE(IOUT, 11)
04600 11 FORMAT('+ NUMBER OF EXEMPTIONS ',$)
04700 IF(ACC)CALL ADUP(EX)
04800 IF(EX.EQ.-99)GO TO 600
04900 IF(ACC.EQ.0)WRITE(IOUT,2)EX
05000 1100 CALL TYP(9,I)
05100 WRITE(IOUT, 12)
05200 12 FORMAT('+ WAGES, ETC. (FROM W2 FORMS) '/)
05300 IF(ACC)CALL ADUP(WG)
05400 IF(WG.EQ.-99)GO TO 102
05600 103 CALL TYP(10,'A')
05700 WRITE(IOUT, 13)
05800 13 FORMAT('+ DIVIDENDS.'/)
05900 IF(ACC)CALL ADUP(DT)
06000 IF(DT.EQ.-99)GO TO 102
06010 IF(DT.EQ.0)GO TO 105
06200 104 CALL TYP(10,'B')
06300 WRITE(IOUT, 14)
06400 14 FORMAT('+ DIVIDEND EXCLUSION. ',$)
06500 IF(ACC)CALL ADUP(DEX)
06600 IF(DEX.EQ.-99)GO TO 103
06700 IF(ACC.EQ.0)WRITE(IOUT,2)DEX
06800 TOTD=DT-DEX
06900 CALL TYP(10,'C')
07000 WRITE(IOUT, 15)TOTD
07100 15 FORMAT('+ TOTAL DIVIDENDS. ',F11.2/)
07200 105 CALL TYP(11,I)
07300 WRITE(IOUT, 16)
07400 16 FORMAT('+ INTEREST INCOME. '/)
07500 IF(ACC)CALL ADUP(RT)
07600 IF(RT.EQ.-99)GO TO 104
07800 106 CALL TYP(12,I)
07900 WRITE(IOUT, 17)
08000 17 FORMAT('+ OTHER INCOME.'/)
08100 602 FORMAT(' ***** GO TO PAGE 2 OF FORM 1040 *****'/,
08150 1' ***** TYPE -999 TO SKIP OVER SECTION AND RETURN TO PG.1'/)
08160 IF(ACC.EQ.0.AND.T38.EQ.0)GO TO 1603
08200 WRITE(IOUT,602)
08300 CALL TYP(28,I)
08400 WRITE(IOUT, 18)
08500 18 FORMAT('+ BUSINESS INCOME-LOSS.'/)
08600 IF(ACC)CALL ADUP(BI)
08650 IF(BI.EQ.-999)GO TO 1603
08700 IF(BI.EQ.-99)GO TO 105
08900 107 CALL TYP(29,I)
09000 WRITE(IOUT, 19)
09100 19 FORMAT('+ CAPITAL ASSETS.'/)
09200 IF(ACC)CALL ADUP(CA)
09300 IF(CA.EQ.-99)GO TO 106
09500 108 CALL TYP(30,I)
09600 WRITE(IOUT, 20)
09700 20 FORMAT('+ SUPPLEMENTAL SCHEDULE.'/)
09800 IF(ACC)CALL ADUP(SU)
09900 IF(SU.EQ.-99)GO TO 107
10100 109 CALL TYP(31,I)
10200 WRITE(IOUT, 21)
10300 21 FORMAT('+ RENTS, ROYALTIES, ETC.'/)
10400 IF(ACC)CALL ADUP(RY)
10500 IF(RY.EQ.-99)GO TO 108
10700 110 CALL TYP(33,I)
10800 WRITE(IOUT, 22)
10900 22 FORMAT('+ PENSIONS, ETC.'/)
11000 IF(ACC)CALL ADUP(PE)
11100 IF(PE.EQ.-99)GO TO 109
11300 111 CALL TYP(34,I)
11400 WRITE(IOUT, 23)
11500 23 FORMAT('+ 50% CAPITAL GAIN.'/)
11600 IF(ACC)CALL ADUP(CP)
11700 IF(CP.EQ.-99)GO TO 110
11900 112 CALL TYP(35,I)
12000 WRITE(IOUT, 24)
12100 24 FORMAT('+ STATE INCOME TAX REFUNDS.'/)
12200 IF(ACC)CALL ADUP(SI)
12300 IF(SI.EQ.-99)GO TO 111
12500 113 CALL TYP(36,I)
12600 WRITE(IOUT, 25)
12700 25 FORMAT('+ ALIMONY INCOME. '/)
12800 IF(ACC)CALL ADUP(ALM)
12900 IF(ALM.EQ.-99)GO TO 112
13000 IF(ACC.EQ.0)WRITE(IOUT,2)ALM
13100 114 CALL TYP(37,I)
13200 WRITE(IOUT, 26)
13300 26 FORMAT('+ OTHER.'/)
13400 IF(ACC)CALL ADUP(OT)
13500 IF(OT.EQ.-99)GO TO 113
13700 CALL TYP(38,I)
13800 T38=BI+CA+SU+RY+PE+CP+SI+ALM+OT
13900 WRITE(IOUT, 60)T38
14000 603 FORMAT(' ***** GO BACK TO PAGE 1 OF FORM 1040 *****'/)
14100 WRITE(IOUT,603)
14200 1603 CALL TYP(12,I)
14250 IF(BI.EQ.-999)BI=0
14300 WRITE(IOUT,60)T38
14400 CALL TYP(13,I)
14500 T13=WG+TOTD+RT+T38
14600 WRITE(IOUT, 60)T13
14700 115 CALL TYP(14,I)
14800 WRITE(IOUT, 27)
14900 27 FORMAT('+ ADJUSTMENTS TO INCOME'/)
15000
15050 IF(ACC.EQ.0.AND.T43.EQ.0)GO TO 1604
15100 WRITE(IOUT,602)
15200 CALL TYP(39,I)
15300 WRITE(IOUT, 28)
15400 28 FORMAT('+ SICK PAY. ',/)
15500 IF(ACC)CALL ADUP(SICK)
15550 IF(SICK.EQ.-999)GO TO 1604
15600 IF(SICK.EQ.-99)GO TO 114
15700 IF(ACC.EQ.0)WRITE(IOUT,2)SICK
15800 116 CALL TYP(40,I)
15900 WRITE(IOUT, 29)
16000 29 FORMAT('+ MOVING EXPENSES. ',/)
16100 IF(ACC)CALL ADUP(RMEX)
16200 IF(RMEX.EQ.-99)GO TO 115
16300 IF(ACC.EQ.0)WRITE(IOUT,2)RMEX
16400 117 CALL TYP(41,I)
16500 WRITE(IOUT, 30)
16600 30 FORMAT('+ EMPLOYEE BUSINESS EXPENSES.'/)
16700 IF(ACC)CALL ADUP(EB)
16800 IF(EB.EQ.-99)GO TO 116
17000 118 CALL TYP(42,I)
17100 WRITE(IOUT, 31)
17200 31 FORMAT('+ SELF-EMPLOYED RETIREMENT PLAN. '/)
17300 IF(ACC)CALL ADUP(SER)
17400 IF(SER.EQ.-99)GO TO 117
17500 IF(ACC.EQ.0)WRITE(IOUT,2)SER
17600 CALL TYP(43,I)
17700 T43=SICK+RMEX+EB+SER
17800 WRITE(IOUT, 60)T43
17900
18000 WRITE(IOUT,603)
18100 1604 CALL TYP(14,I)
18150 IF(SICK.EQ.-999)SICK=0
18200 WRITE(IOUT, 60)T43
18300 T15=T13-T43
18400 CALL TYP(15,I)
18500 WRITE(IOUT, 32)T15
18600 32 FORMAT('+ ADJUSTED GROSS INCOME.',F13.2/)
18700 IF(T15.LT.10000.)CALL SMALL(T15)
18800 CALL STDED(T15)
18900 IF(ACC)WRITE(IOUT, 34)
19000 34 FORMAT(/' ***** ITEMIZE DEDUCTIONS? '$)
19100 IF(ACC)ACCEPT 3,JIT
19200 IF(JIT.EQ.'N')GO TO 6900
19300 C*************************************
19400 119 WRITE(IOUT, 35)
19500 35 FORMAT(/' ***** GO TO SCHEDULE A *****')
19600 WRITE(IOUT, 36)
19700 36 FORMAT(/' ----- MEDICAL - DENTAL '/)
19800 IF(ACC.EQ.0)GO TO 3700
19900 CALL TYP(1,I)
20000 WRITE(IOUT, 37)
20100 37 FORMAT('+ TOTAL OF INSURANCE PREMIUMS. '/)
20200 IF(ACC)CALL ADUP(RMI)
20300 IF(RMI.EQ.-99)GO TO 118
20500 3700 T1=RMI/2.
20600 IF(T1.GT.150.)T1=150.
20700 CALL TYP(1,I)
20800 WRITE(IOUT, 2)T1
20900 120 CALL TYP(2,I)
21000 WRITE(IOUT, 38)
21100 38 FORMAT('+ MEDICINE AND DRUGS. '/)
21200 IF(ACC)CALL ADUP(RM)
21300 IF(RM.EQ.-99)GO TO 119
21500 CALL TYP(3,I)
21600 61 FORMAT('+ 1% OF LINE 15-- ',F10.2/)
21700 ONP=T15/100.
21800 WRITE(IOUT, 61)ONP
21900 T4=RM-ONP
22000 IF(T4)T4=0
22100 CALL TYP(4,I)
22200 WRITE(IOUT, 2)T4
22300 CALL TYP(5,I)
22400 T5=RMI-T1
22500 IF(T5)T5=0
22600 62 FORMAT('+ BALANCE OF INSURANCE PREMIUMS. ',F10.2/)
22700 WRITE(IOUT, 62)T5
22800 CALL TYP(6,I)
22900 WRITE(IOUT, 39)
23000 39 FORMAT('+ OTHER MEDICAL AND DENTAL EXPENSES.'/)
23100 121 CALL TYP(6,'A')
23200 WRITE(IOUT, 40)
23300 40 FORMAT('+ DOCTORS, DENTISTS, ETC.'/)
23400 IF(ACC)CALL ADUP(DO)
23500 IF(DO.EQ.-99)GO TO 120
23700 122 CALL TYP(6,'B')
23800 WRITE(IOUT, 41)
23900 41 FORMAT('+ HOSPITALS.'/)
24000 IF(ACC)CALL ADUP(HOSP)
24100 IF(HOSP.EQ.-99)GO TO 121
24200 IF(ACC.EQ.0)WRITE(IOUT,2)HOSP
24300 123 CALL TYP(6,'C')
24400 WRITE(IOUT, 26)
24500 IF(ACC)CALL ADUP(DT)
24600 IF(DT.EQ.-99)GO TO 122
24800 T7=T4+T5+DO+HOSP+DT
24900 CALL TYP(7,I)
25000 WRITE(IOUT, 60)T7
25100 T8=T15*.03
25200 CALL TYP(8,I)
25300 WRITE(IOUT, 2)T8
25400 T9=T7-T8
25500 IF(T9)T9=0
25600 CALL TYP(9,I)
25700 WRITE(IOUT, 2)T9
25800 T10=T9+T1
25900 CALL TYP(10,I)
26000 WRITE(IOUT, 60)T10
26100 CALL TYP(35,I)
26200 WRITE(IOUT, 60)T10
26300
26400 43 FORMAT(/' ----- TAXES'/)
26500 WRITE(IOUT, 43)
26600 124 CALL TYP(11,I)
26700 WRITE(IOUT, 44)
26800 44 FORMAT('+ STATE AND LOCAL INCOME.'/)
26900 IF(ACC)CALL ADUP(TA)
27000 IF(TA.EQ.-99)GO TO 123
27200 125 CALL TYP(12,I)
27300 WRITE(IOUT, 45)
27400 IF(ACC)CALL ADUP(RX)
27500 IF(RX.EQ.-99)GO TO 124
27700 126 CALL TYP(13,I)
27800 WRITE(IOUT, 42)
27900 42 FORMAT('+ GASOLINE TAX (SEE TABLES) '/)
28000 IF(ACC)CALL ADUP(GTAX)
28100 IF(GTAX.EQ.-99)GO TO 125
28200 IF(ACC.EQ.0)WRITE(IOUT,2)GTAX
28300 127 CALL TYP(14,I)
28400 WRITE(IOUT, 46)
28500 46 FORMAT('+ GENERAL SALES. (SEE TABLES) '/)
28600 IF(ACC)CALL ADUP(STAX)
28700 IF(STAX.EQ.-99)GO TO 126
28800 IF(ACC.EQ.0)WRITE(IOUT,2)STAX
28900 128 CALL TYP(15,I)
29000 WRITE(IOUT, 47)
29100 47 FORMAT('+ PERSONAL PROPERTY'/)
29200 IF(ACC)CALL ADUP(PTAX)
29300 IF(PTAX.EQ.-99)GO TO 127
29400 IF(ACC.EQ.0)WRITE(IOUT,2)PTAX
29500 129 CALL TYP(16,I)
29600 WRITE(IOUT, 26)
29700 IF(ACC)CALL ADUP(XO)
29800 IF(XO.EQ.-99)GO TO 128
30000 CALL TYP(17,I)
30100 T17=TA+RX+GTAX+STAX+PTAX+XO
30200 WRITE(IOUT, 60)T17
30300 CALL TYP(36,I)
30400 WRITE(IOUT, 60)T17
30500 130 WRITE(IOUT, 48)
30600 48 FORMAT(/' ----- INTEREST EXPENSE'/)
30700 CALL TYP(18,I)
30800 WRITE(IOUT, 49)
30900 49 FORMAT('+ HOME MORTGAGE.'/)
31000 IF(ACC)CALL ADUP(RMO)
31100 IF(RMO.EQ.-99)GO TO 129
31300 131 CALL TYP(19,I)
31400 WRITE(IOUT, 26)
31500 IF(ACC)CALL ADUP(ROH)
31600 IF(ROH.EQ.-99)GO TO 130
31800 CALL TYP(20,I)
31900 T20=RMO+ROH
32000 WRITE(IOUT, 60)T20
32100 CALL TYP(37,I)
32200 WRITE(IOUT, 60)T20
32300
32400 132 WRITE(IOUT, 50)
32500 50 FORMAT(/' ----- CONTRIBUTIONS '/)
32600 CALL TYP(21,'A')
32700 WRITE(IOUT, 51)
32800 51 FORMAT('+ CASH CONTRIBUTIONS.'/)
32900 IF(ACC)CALL ADUP(CO)
33000 IF(CO.EQ.-99)GO TO 131
33200 133 CALL TYP(21,'B')
33300 WRITE(IOUT, 26)
33400 IF(ACC)CALL ADUP(OC)
33500 IF(OC.EQ.-99)GO TO 132
33700 134 CALL TYP(22,I)
33800 WRITE(IOUT, 510)
33900 510 FORMAT('+ OTHER THAN CASH (SEE PAGE 12).'/)
34000 IF(ACC)CALL ADUP(OCA)
34100 IF(OCA.EQ.-99)GO TO 133
34300 135 CALL TYP(23,I)
34400 WRITE(IOUT, 52)
34500 52 FORMAT('+ CARRY OVER FROM PRIOR YEARS.'/)
34600 IF(ACC)CALL ADUP(PRIOR)
34700 IF(PRIOR.EQ.-99)GO TO 134
34800 IF(ACC.EQ.0)WRITE(IOUT,2)PRIOR
34900 136 CALL TYP(24,I)
35000 T24=PRIOR+OCA+OC+CO
35100 WRITE(IOUT, 60)T24
35200 CALL TYP(38,I)
35300 WRITE(IOUT, 60)T24
35400 137 WRITE(IOUT, 53)
35500 53 FORMAT(/' ----- CASUALTY OR THEFT LOSSES'/)
35600 CALL TYP(25,I)
35700 54 FORMAT('+ LOSS BEFORE INSURANCE REIMBURSEMENT.'/)
35800 WRITE(IOUT, 54)
35900 IF(ACC)CALL ADUP(RLOSS)
36000 IF(RLOSS.EQ.-99)GO TO 136
36010 IF(RLOSS.EQ.0)GO TO 139
36100 IF(ACC.EQ.0)WRITE(IOUT,2)RLOSS
36200 138 CALL TYP(26,I)
36300 WRITE(IOUT, 55)
36400 IF(ACC)CALL ADUP(RIR)
36500 IF(RIR.EQ.-99)GO TO 137
36600 IF(ACC.EQ.0)WRITE(IOUT,2)RIR
36700 CALL TYP(27,I)
36800 T27=RLOSS-RIR
36900 IF(T27)T27=0
37000 WRITE(IOUT, 60)T27
37100 T28=100.
37200 IF(T27.LT.T28)T28=T27
37300 CALL TYP(28,I)
37400 WRITE(IOUT, 2)T28
37500 T29=T27-T28
37600 CALL TYP(29,I)
37700 WRITE(IOUT, 60)T29
37800 CALL TYP(39,I)
37900 WRITE(IOUT, 60)T29
38000 139 WRITE(IOUT, 56)
38100 56 FORMAT(/' ----- MISCELLANEOUS DEDUCTIONS '/)
38200 CALL TYP(30,I)
38300 WRITE(IOUT, 57)
38400 IF(ACC)CALL ADUP(ALIMON)
38500 IF(ALIMON.EQ.-99)GO TO 138
38600 IF(ACC.EQ.0)WRITE(IOUT,2)ALIMON
38700 140 CALL TYP(31,I)
38800 WRITE(IOUT, 58)
38900 IF(ACC)CALL ADUP(UN)
39000 IF(UN.EQ.-99)GO TO 139
39200 141 CALL TYP(32,I)
39300 WRITE(IOUT, 59)
39400 IF(ACC)CALL ADUP(CAD)
39500 IF(CAD.EQ.-99)GO TO 140
39600 IF(ACC.EQ.0)WRITE(IOUT,2)CAD
39700 142 CALL TYP(33,I)
39800 WRITE(IOUT, 26)
39900 IF(ACC)CALL ADUP(RMO)
40000 IF(RMO.EQ.-99)GO TO 141
40200 T34=ALIMONY+UN+CAD+RMO
40300 CALL TYP(34,I)
40400 WRITE(IOUT, 60)T34
40500 CALL TYP(40,I)
40600 WRITE(IOUT, 60)T34
40700 WRITE(IOUT, 63)
40800 63 FORMAT(' ----- SUMMARY OF DEDUCTIONS.'/)
40900 CALL TYP(35,I)
41000 WRITE(IOUT, 64)T10
41100 64 FORMAT('+ MEDICAL AND DENTAL.',F12.2/)
41200 CALL TYP(36,I)
41300 WRITE(IOUT, 65)T17
41400 65 FORMAT('+ TOTAL TAXES.',F12.2/)
41500 650 FORMAT('+ TOTAL INTEREST.',F12.2/)
41600 66 FORMAT('+ TOTAL CONTRIBUTIONS.',F12.2/)
41700 67 FORMAT('+ CASUALTY OR THEFT LOSS.',F12.2/)
41800 68 FORMAT('+ TOTAL MISCELLANEAOUS.',F12.2/)
41900 69 FORMAT('+ TOTAL DEDUCTIONS.',F12.2/)
42000 CALL TYP(37,I)
42100 WRITE(IOUT, 650)T20
42200 CALL TYP(38,I)
42300 WRITE(IOUT, 66)T24
42400 CALL TYP(39,I)
42500 WRITE(IOUT, 67)T29
42600 CALL TYP(40,I)
42700 WRITE(IOUT, 68)T34
42800 CALL TYP(41,I)
42900 T41=T34+T29+T20+T17+T10
43000 WRITE(IOUT, 69)T41
43100
43200 WRITE(IOUT,602)
43300 6900 CALL TYP(44,I)
43400 WRITE(IOUT,32)T15
43500 IF(JIT.NE.'Y')GO TO 6901
43600 CALL TYP(45,'A')
43700 WRITE(IOUT, 69)T41
43800 6901 T45B=T15*.15
43900 X=2000
44000 IF(MFS.EQ.'Y')X=1000
44100 IF(T45B.GT.X)T45B=X
44200 CALL TYP(45,'B')
44300 WRITE(IOUT, 69)T45B
44400 T46=T15-T41
44500 T46B=T15-T45B
44600 IF(JIT.NE.'Y')GO TO 6902
44700 CALL TYP(46,'A')
44800 WRITE(IOUT, 2)T46
44900 6902 CALL TYP(46,'B')
45000 WRITE(IOUT, 2)T46B
45100 CALL TYP(47,I)
45200 X=EX*750
45300 WRITE(IOUT, 70)X
45400 70 FORMAT('+ EXEMPTIONS X $750.',F12.2/)
45500 IF(JIT.NE.'Y')GO TO 71
45600 CALL TYP(48,'A')
45700 T48=T46-X
45800 T48B=T46B-X
45900 WRITE(IOUT, 71)T48
46000 71 FORMAT('+ TAXABLE INCOME -- ',F12.2/)
46100 CALL TYP(48,'B')
46200 WRITE(IOUT, 71)T48B
46300 7216 WRITE(IOUT, 72)
46400 72 FORMAT(//' FIGURE YOUR TAX WITH SCHED. X,Y OR Z.'/)
46500 IF(ACC.EQ.0)GO TO 73
46600 TYPE 722
46700 722 FORMAT(' TYPE APPROPRIATE $, % AND $ FROM LAST 2 COLUMNS OF
46800 1SCHEDULES X, Y OR Z.'/)
46900 ACCEPT 1,X,Y,Z
47000 IF(X.EQ.-99)GO TO 142
47100 TAX=X+(T48-Z)*Y/100.
47200 73 FORMAT('+ YOUR TAX -- ',F12.2/)
47300 CALL TYP(16,I)
47400 WRITE(IOUT,73)TAX
47500 C****** CREDITS ********************
47600 741 FORMAT(' ----- CREDITS'/)
47700 WRITE(IOUT,741)
47750
47760 IF(ACC.EQ.0.AND.T54.EQ.0)GO TO 1605
47775 WRITE(IOUT,602)
47800 CALL TYP(49,I)
47900 742 FORMAT('+ RETIREMENT INCOME CREDIT. (SCHED. R) '/)
48000 WRITE(IOUT,742)
48100 IF(ACC)CALL ADUP(RIC)
48150 IF(RIC.EQ.-999)GO TO 1605
48200 IF(RIC.EQ.-99)GO TO 142
48300 IF(ACC.EQ.0)WRITE(IOUT,2)RIC
48400 743 FORMAT('+ INVESTMENT CREDIT. (FORM 3468) '/)
48500 CALL TYP(50,I)
48600 WRITE(IOUT,743)
48700 IF(ACC)CALL ADUP(RIVC)
48800 IF(RIVC.EQ.-99)GO TO 742
48900 IF(ACC.EQ.0)WRITE(IOUT,2)RIVC
49000 744 FORMAT('+ FOREIGN TAX CREDIT. (FORM 1116) '/)
49100 CALL TYP(51,I)
49200 WRITE(IOUT,744)
49300 IF(ACC)CALL ADUP(FTX)
49400 IF(FTX.EQ.-99)GO TO 743
49500 IF(ACC.EQ.0)WRITE(IOUT,2)FTX
49600 745 FORMAT('+ CREDIT FOR CONTRBS. TO CANDS. (SEE PG.9) '/)
49700 CALL TYP(52,I)
49800 WRITE(IOUT,745)
49900 IF(ACC)CALL ADUP(CCC)
50000 IF(CCC.EQ.-99)GO TO 744
50100 IF(ACC.EQ.0)WRITE(IOUT,2)CCC
50200 746 FORMAT('+ WORK INCENTIVE CREDIT. (FORM 4874) '/)
50300 CALL TYP(53,I)
50400 WRITE(IOUT,746)
50500 IF(ACC)CALL ADUP(WIC)
50600 IF(WIC.EQ.-99)GO TO 745
50700 IF(ACC.EQ.0)WRITE(IOUT,2)WIC
50800 CALL TYP(54,I)
50900 T54=RIC+FTX+CCC+WIC+RIVC
51000 WRITE(IOUT,60)T54
51100 C******************************* PAGE 1 AGAIN ***********
51150 WRITE(IOUT,603)
51200 1605 CALL TYP(17,I)
51250 IF(RIC.EQ.-999)RIC=0
51300 WRITE(IOUT, 74)T54
51400 74 FORMAT('+ TOTAL CREDITS.',F12.2/)
51500 T18=TAX-T54
51600 CALL TYP(18,I)
51700 WRITE(IOUT, 75),T18
51800 75 FORMAT('+ ******** INCOME TAX ******',F12.2/)
51900 C******** BACK TO PAGE 2 **************************
52000 760 FORMAT('+ SELF-EMPLOYMENT TAX. (SCHED. SE) '/)
52010 IF(ACC.EQ.0.AND.T61.EQ.0)GO TO 1606
52050 WRITE(IOUT,602)
52100 CALL TYP(55,I)
52200 WRITE(IOUT,760)
52300 IF(ACC)CALL ADUP(SETX)
52350 IF(SETX.EQ.-999)GO TO 1606
52400 IF(SETX.EQ.-99)GO TO 74
52500 IF(ACC.EQ.0)WRITE(IOUT,2)SETX
52600 761 FORMAT('+ TAX FROM RECOMPUTING INV.(FORM 4255) '/)
52700 CALL TYP(56,I)
52800 WRITE(IOUT,761)
52900 IF(ACC)CALL ADUP(TRI)
53000 IF(TRI.EQ.-99)GO TO 760
53100 IF(ACC.EQ.0)WRITE(IOUT,2)TRI
53200 762 FORMAT('+ TAX FROM RECOMPUTING WIN. (+ SCHED.) '/)
53300 CALL TYP(57,I)
53400 WRITE(IOUT,762)
53500 IF(ACC)CALL ADUP(TRW)
53600 IF(TRW.EQ.-99)GO TO 761
53700 IF(ACC.EQ.0)WRITE(IOUT,2)TRW
53800 763 FORMAT('+ MINIMUM TAX? (FORM 4725) '/)
53900 CALL TYP(58,I)
54000 WRITE(IOUT,763)
54100 IF(ACC)CALL ADUP(RMT)
54200 IF(RMT.EQ.-99)GO TO 762
54300 IF(ACC.EQ.0)WRITE(IOUT,2)RMT
54400 764 FORMAT('+ SOCIAL SECURITY TAX ON TIPS. (FORM 4137) '/)
54500 CALL TYP(59,I)
54600 WRITE(IOUT,764)
54700 IF(ACC)CALL ADUP(SST)
54800 IF(ACC.EQ.0)WRITE(IOUT,2)SST
54900 IF(SST.EQ.-99)GO TO 763
55000 765 FORMAT('+ UNCOLLECTED SOC. SEC. TAX ON TIPS. '/)
55100 CALL TYP(60,I)
55200 WRITE(IOUT,765)
55300 IF(ACC)CALL ADUP(TIPS)
55400 IF(TIPS.EQ.-99)GO TO 764
55500 IF(ACC.EQ.0)WRITE(IOUT,2)TIPS
55600 CALL TYP(61,I)
55700 T61=TIPS+SST+RMT+TRW+TRI+SETX
55800 WRITE(IOUT,60)T61
55825
55840 C***** BACK TO PG.1 *******
55850 WRITE(IOUT,603)
55900 1606 CALL TYP(19,I)
55950 IF(SETX.EQ.-999)SETX=0
56000 WRITE(IOUT, 76)T61
56100 76 FORMAT('+ OTHER TAXES (LINE 61). ',F12.2/)
56200 T20T=TAX+T61
56300 CALL TYP(20,I)
56400 WRITE(IOUT, 60)T20T
56500 7721 CALL TYP(21,'A')
56600 77 FORMAT('+ FEDERAL TAX WITHHELD.'/)
56700 WRITE(IOUT, 77)
56800 IF(ACC)CALL ADUP(WT)
56900 IF(WT.EQ.-99)GO TO 75
57100 CALL TYP(21,'A')
57200 WRITE(IOUT, 60)WT
57300 CALL TYP(21,'B')
57400 WRITE(IOUT, 78)
57500 78 FORMAT('+ 1973 ESTIMATED TAX PAYMENTS.'/)
57600 IF(ACC)CALL ADUP(ET)
57700 IF(ET.EQ.-99)GO TO 77
57900 79 FORMAT('+ AMOUNT PAID WITH FORM 4868. '/)
58000 CALL TYP(21,'C')
58100 WRITE(IOUT, 79)
58200 IF(ACC)CALL ADUP(FORM)
58300 IF(FORM.EQ.-99)GO TO 78
58400 IF(ACC.EQ.0)WRITE(IOUT,2)FORM
58500 80 CALL TYP(21,'D')
58600 WRITE(IOUT, 26)
58650
58660 IF(ACC.EQ.0.AND.T65.EQ.0)GO TO 1607
58675 WRITE(IOUT,602)
58700 800 FORMAT('+ EXCESS FICA TAX WITHHELD. (SEE PG.9) '/)
58800 CALL TYP(62,I)
58900 WRITE(IOUT,800)
59000 IF(ACC)CALL ADUP(FIC)
59100 IF(FIC.EQ.-99)GO TO 78
59150 IF(FIC.EQ.-999)GO TO 1607
59300 801 FORMAT('+ CREDIT FOR FED. TAX ON FUELS. (FORM 4136) '/)
59400 CALL TYP(63,I)
59500 WRITE(IOUT,801)
59600 IF(ACC)CALL ADUP(FUEL)
59700 IF(FUEL.EQ.-99)GO TO 800
59800 IF(ACC.EQ.0)WRITE(IOUT,2)FUEL
59900 802 FORMAT('+ CREDIT FROM REGULATED INVSTMT. CO. (FORM 2439) '/)
60000 CALL TYP(64,I)
60100 WRITE(IOUT,802)
60200 IF(ACC)CALL ADUP(CRICC)
60300 IF(CRICC.EQ.-99)GO TO 801
60400 IF(ACC.EQ.0)WRITE(IOUT,2)CRICC
60500 T65=FIC+FUEL+CRICC
60600 CALL TYP(65,T54,I)
60700 WRITE(IOUT,60)T65
60710
60755 WRITE(IOUT,603)
60800 1607 CALL TYP(21,'D')
60850 IF(FIC.EQ.-999)FIC=0
60900 WRITE(IOUT, 26)
61000 IF(ACC.EQ.0)WRITE(IOUT,2)T65
61100 T22=WT+ET+FORM+T65
61200 CALL TYP(22,I)
61300 WRITE(IOUT, 60)T22
61500 T23=T20T-T22
61600 T23T=T23
61700 IF(T23T)T23T=0
61800 CALL TYP(23,I)
61900 82 FORMAT('+ BALANCE DUE. ------ ',F12.2/)
62000 WRITE(IOUT, 82)T23T
62100 T23=-T23
62200 IF(T23)T23=0
62300 CALL TYP(24,I)
62400 WRITE(IOUT, 83)T23
62500 83 FORMAT('+ OVERPAID ---------- ',F12.2)
62600 CALL TYP(25,I)
62700 WRITE(IOUT, 84)T23
62800 84 FORMAT('+ REFUNDED TO YOU --- ',F12.2)
62810 IF(IOUT.EQ.3)CALL EXIT
62850 IF(ACC.EQ.0)GO TO 860
62900 WRITE(IOUT, 85)
63100 85 FORMAT(//' TYPE FILE NAME. '$)
63200 ACCEPT 4,NAME
63300 CALL OFILE(1,NAME)
63400 WRITE(1)
63500 1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
63600 1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
63700 1 JIT,T61,T65,T54,
64000 1 EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
64100 1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
64200 1,T1,RM,T4,T5,DO,HOSP,DT,T7,T8,T9,T10,TA,RX,GTAX,STAX
64300 WRITE(1)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
64400 1 T27,T28,T29,ALIMON,UN,RMO,T34,T10,T17,T41,T45B,T46,T46B
64500 1,T48,T48B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
64600 1,T23T,T23,K
64700 GO TO 5
64800 201 CALL IFILE(21,NAME)
64900 READ(21)
65000 1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
65100 1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
65200 1 JIT,T61,T65,T54,
65300 1 EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
65400 1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
65500 1,T1,RM,T4,T5,DO,HOSP,DT,T7,T8,T9,T10,TA,RX,GTAX,STAX
65600 READ(21)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
65700 1 T27,T28,T29,ALIMON,UN,RMO,T34,T10,T17,T41,T45B,T46,T46B
65800 1,T48,T48B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
65900 1,T23T,T23,K
66200 860 TYPE 86
66300 86 FORMAT(' R=REWORK, T=TYPE ON TTY, L=LIST ON LPT.'/)
66400 ACCEPT 3,N
66500 IF(N.EQ.'R')GO TO 87
66600 ACC=0
66700 IF(N.EQ.'T')GO TO 4
66800 IOUT=3
66900 GO TO 4
67000 87 TYPE 88
67100 88 FORMAT(' START AT LINE 9,16,21,28,39,44,49,55,62 -- OR IN
67200 1 SCHED. A, 1,11,18,25,30?'/)
67300 ACCEPT 1,X
67400 K=X
67500 IF(K.GT.30)GO TO 89
67600 GO TO(119,1,1,1,1,1,1,1, 1100,1, 43,1,1,1,1, 7216,1, 130,
67700 1 1,1, 7721,1,1,1, 137,1,1, 17,1, 139)K
67800 89 J=K-38
67900 GO TO(27,1,1,1,1)J
68000 C ABOVE NOT FINISHED.
68100 5 END